home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
doors_1
/
dframe37.zip
/
DFDEMO.ZIP
/
DFDEMO.BAS
next >
Wrap
BASIC Source File
|
1992-09-22
|
13KB
|
349 lines
DEFINT A-Z
' $INCLUDE: '\inc\dframe.inc' 'change path if needed
' $INCLUDE: '\inc\owner.inc' 'contains my serial #. Delete this
'line if need be.
ProgName$ = "DoorFrame Demo"
ExeName$ = "DFDEMO"
Version$ = " 1.0"
INITIALIZE
CLOSE #1
DETECT.ANSI 'Make sure the caller is ANSI capable!
ON ERROR GOTO Err.Routine 'Errors? What errors?
SysopKeys% = 1 'Use alternate set so we can use the arrows
DIM Menu$(8) 'Holds our Menu entries
'Since this demo uses cursor positioning, the caller must be ANSI compatible.
'Kick him out if he isn't.
IF Graphics% = 0 THEN
ClrScrn Black
Dis.Play "This Door requires ANSI.SYS compatibility!", Lwhite, Black, 0, 0, 1, 1, 1, 0, 0
Dis.Play "Returning you to the BBS", Lwhite, Black, 0, 0, 2, 1, 1, 0, 0
DE.LAY 3
EXIT.DOOR "Y"
END IF
'Also needs color to see the demo. If not in color mode, ask to switch.
PriorMode% = Mode% 'Save current color mode
IF Mode% = 0 THEN 'Does he have color on?
Dis.Play "You will need to be in Color Mode to see this demo.", Lwhite, Black, 0, 1, 10, 1, 1, 1, 0
Dis.Play "Type Y to switch to Color or N to return to BBS [Y/n] > ", Lwhite, Black, 0, 0, 12, 1, 0, 1, 0
IF UCASE$(Response$) <> "N" THEN
Mode% = -1 'Turn color on
ELSE
EXIT.DOOR "Y"
END IF
END IF
Menu$(1) = "}B}ox.It Demo"
Menu$(2) = "Clr}E}ol Demo"
Menu$(3) = "}C}lrScrn Demo"
Menu$(4) = "}D}is.Play Demo"
Menu$(5) = "}I}n.Put Demo"
Menu$(6) = "Make.Blt Dem}O}" 'Can't use M when SysopKeys% = 1
Menu$(7) = "}S}end Demo"
Menu$(8) = "}G}et me out!"
Start:
MenuPos% = 1 'Where are we on the Menu?
ClrScrn Blue 'Clear the screen with a BLUE background
'Draw a box for our menu
BOX.IT 5, 30, 16, 50, 2, Lwhite, CYAN, Lwhite, CYAN, 32, 0, "Menu", 0, 7
'Write the menu and highlight bar
FOR x = 1 TO 8
Dis.Play Menu$(x), Black, CYAN, 0, 0, x + 6, 33, 1, 0, 0
NEXT
Dis.Play Menu$(MenuPos%), Black, WHITE, 0, 0, MenuPos% + 6, 33, 1, 0, 0
'Qmodem redefines the arrow keys. Any feedback on other term programs?
Dis.Play "If you are using Qmodem, switch to DoorWay mode to use the arrows.", Lwhite, Blue, 0, 0, 22, 1, 1, 1, 0
GetInput:
'Prompt for a choice. Get a 1-key response and act on it
IN.PUT 1, 0, LCYAN, Blue, 1, "Your Choice? ", 19, 34, 1
SELECT CASE UCASE$(Response$) 'Response$ holds the callers input.
CASE "B"
GOSUB BoxDemo
CASE "E"
GOSUB EolDemo
CASE "C"
GOSUB ClrDemo
CASE "D"
GOSUB DisplayDemo
CASE "I"
GOSUB InputDemo
CASE "O"
GOSUB BltDemo
CASE "S"
GOSUB SendDemo
CASE "G"
GOTO GoodBye
CASE "UP" 'Returned in Response$ when using alternate Sysop
'keys and the UP Arrow or captial H is pressed.
Dis.Play Menu$(MenuPos%), Black, CYAN, 0, 0, MenuPos% + 6, 33, 1, 0, 0
IF MenuPos% = 1 THEN
MenuPos% = 8
ELSE
MenuPos% = MenuPos% - 1
END IF
Dis.Play Menu$(MenuPos%), Black, WHITE, 0, 0, MenuPos% + 6, 33, 1, 0, 0
GOTO GetInput
CASE "DOWN"
Dis.Play Menu$(MenuPos%), Black, CYAN, 0, 0, MenuPos% + 6, 33, 1, 0, 0
IF MenuPos% = 8 THEN
MenuPos% = 1
ELSE
MenuPos% = MenuPos% + 1
END IF
Dis.Play Menu$(MenuPos%), Black, WHITE, 0, 0, MenuPos% + 6, 33, 1, 0, 0
GOTO GetInput
CASE ""
ON MenuPos% GOSUB BoxDemo, EolDemo, ClrDemo, DisplayDemo, InputDemo, BltDemo, SendDemo, GoodBye
CASE ELSE
'Display boo-boo message with a bell and wait 4 seconds
Dis.Play "Invalid selection!", LRED, Blue, 0, 1, 19, 32, 0, 0, 0
DE.LAY 4
CLREOL 19, 32, Blue 'Clear the message off
GOTO GetInput
END SELECT
GOTO Start 'Back to the Menu
BoxDemo: 'Box.It and Lines demo
'10x15 Box with no borders, shadow or title
ClrScrn WHITE
BOX.IT 2, 2, 11, 16, 0, Lwhite, Blue, LCYAN, Blue, 32, 0, "", 0, 0
'Tell 'em what it is
Dis.Play "10x15 Box", Lwhite, Blue, 0, 0, 3, 4, 0, 0, 0
Dis.Play "No Border", Lwhite, Blue, 0, 0, 5, 4, 0, 0, 0
Dis.Play "No Title", Lwhite, Blue, 0, 0, 7, 4, 0, 0, 0
Dis.Play "No Shadow", Lwhite, Blue, 0, 0, 9, 4, 0, 0, 0
'With border
BOX.IT 2, 21, 11, 36, 2, Lwhite, Blue, LCYAN, Blue, 32, 0, "", 0, 0
Dis.Play "Same box", Lwhite, Blue, 0, 0, 5, 24, 0, 0, 0
Dis.Play "With border", Lwhite, Blue, 0, 0, 7, 24, 0, 0, 0
'Add a shadow
BOX.IT 2, 41, 11, 56, 2, Lwhite, Blue, LCYAN, Blue, 32, 1, "", 0, 0
Dis.Play "Same box", Lwhite, Blue, 0, 0, 5, 44, 0, 0, 0
Dis.Play "With shadow", Lwhite, Blue, 0, 0, 7, 44, 0, 0, 0
'Add a title
BOX.IT 2, 61, 11, 76, 2, Lwhite, Blue, LCYAN, Blue, 32, 1, "Title Demo", LCYAN, RED
Dis.Play "Same box", Lwhite, Blue, 0, 0, 5, 64, 0, 0, 0
Dis.Play "With title", Lwhite, Blue, 0, 0, 7, 64, 0, 0, 0
'Now add some lines
Dis.Play "Now let's add some lines to the boxes", LRED, WHITE, 1, 0, 13, 1, 0, 1, 0
'Pause for effect
DE.LAY 2
LINES 4, 2, 15, "H", 0, 2, Lwhite, Blue, Lwhite, Blue
LINES 6, 2, 15, "H", 0, 1, Lwhite, Blue, Lwhite, Blue
LINES 8, 2, 15, "H", 0, 2, Lwhite, Blue, Lwhite, Blue
DE.LAY 2
LINES 4, 21, 16, "H", 2, 2, Lwhite, Blue, Lwhite, Blue
LINES 6, 21, 16, "H", 2, 1, Lwhite, Blue, Lwhite, Blue
LINES 8, 21, 16, "H", 2, 2, Lwhite, Blue, Lwhite, Blue
DE.LAY 2
LINES 4, 41, 16, "H", 2, 2, Lwhite, Blue, Lwhite, Blue
LINES 6, 41, 16, "H", 2, 1, Lwhite, Blue, Lwhite, Blue
LINES 8, 41, 16, "H", 2, 2, Lwhite, Blue, Lwhite, Blue
LINES 2, 48, 10, "V", 2, 1, Lwhite, Blue, Lwhite, Blue
CLREOL 13, 1, WHITE
Dis.Play "How about some multi-colored boxes!!", Black, WHITE, 0, 0, 13, 1, 0, 1, 0
DE.LAY 4
'Draw a big box
BOX.IT 15, 2, 20, 77, 2, Lwhite, Blue, LCYAN, Blue, 32, 1, "Title Demo", LCYAN, RED
'Divide it in 3 parts
LINES 15, 27, 6, "V", 2, 1, Lwhite, Blue, Lwhite, Blue
LINES 15, 52, 6, "V", 2, 1, Lwhite, Blue, Lwhite, Blue
'Color in 2 of them
BOX.IT 16, 28, 19, 51, 0, Lwhite, GREEN, LCYAN, GREEN, 32, 0, "", 0, 0
BOX.IT 16, 53, 19, 76, 0, Lwhite, RED, LCYAN, RED, 32, 0, "", 0, 0
ENTER
RETURN
EolDemo: 'ClrEol demo
ClrScrn Black
Dis.Play "ClrEol Demo", Lwhite, Black, 0, 0, 1, 1, 0, 1, 0
' Clear 8 lines using each of the background colors
FOR x = 1 TO 7
CLREOL x + 3, 1, x
NEXT
Dis.Play "Clears from specified row/column to the End of Line in 8 Background colors", Lwhite, Black, 0, 0, 11, 1, 1, 1, 0
'Do it again but put 2 different colors on each line
FOR x = 1 TO 7
CLREOL x + 12, 1, x
IF x < 4 THEN
CLREOL x + 12, 41, x + 4
ELSE
CLREOL x + 12, 41, x - 3
END IF
NEXT
Dis.Play "Multiple use results in lines with 2 or more colors", Lwhite, Black, 0, 0, 20, 1, 1, 1, 0
ENTER
RETURN
ClrDemo: 'ClrScrn demo
'Clear the screen using the 8 available background colors
FOR x = 0 TO 7
ClrScrn x
IF x = 7 THEN
'7 = White so change foreground to Black
Dis.Play "ClrScrn Demo using background color" + STR$(x), Black, x, 0, 0, 11, 1, 0, 1, 0
ELSE
Dis.Play "ClrScrn Demo using background color" + STR$(x), Lwhite, x, 0, 0, 11, 1, 0, 1, 0
END IF
DE.LAY 4
NEXT
ENTER
RETURN
DisplayDemo: 'Dis.Play demo
'Demonstrate various ways of using the Dis.Play statement
ClrScrn Black
Dis.Play "To demonstrate the Upper/Lower Case, please type a few words with mixed case", Lwhite, Black, 0, 0, 11, 1, 1, 0, 0
IN.PUT 70, 0, LCYAN, Black, 1, "> ", 12, 1, 1
IF Response$ = "" OR Response$ < "A" THEN
CLREOL 11, 1, 0
CLREOL 12, 1, 0
Dis.Play "Ok, fine!", Lwhite, Black, 0, 0, 11, 1, 1, 1, 0
ELSE
CLREOL 11, 1, 0
CLREOL 12, 1, 0
Dis.Play "Your response in lower case.", Lwhite, Black, 0, 0, 9, 1, 1, 1, 0
Dis.Play Response$, Lwhite, Black, 0, 0, 11, 1, 1, 1, -1
DE.LAY 4
CLREOL 9, 1, 0
CLREOL 11, 1, 0
Dis.Play "Your response in upper case.", Lwhite, Black, 0, 0, 9, 1, 1, 1, 0
Dis.Play Response$, Lwhite, Black, 0, 0, 11, 1, 1, 1, 1
END IF
DE.LAY 4
CLREOL 9, 1, 0
CLREOL 11, 1, 0
Dis.Play "This is a normal line in White on Black", Lwhite, Black, 0, 0, 11, 1, 1, 0, 0
DE.LAY 4
CLREOL 11, 1, 0
Dis.Play "Blinking White on Black", Lwhite, Black, 1, 0, 11, 1, 1, 0, 0
DE.LAY 4
CLREOL 11, 1, 0
Dis.Play "Blinking White on Black and Centered", Lwhite, Black, 1, 0, 11, 1, 1, 1, 0
DE.LAY 4
CLREOL 11, 1, 0
Dis.Play "Normal White on Black with |Magenta| and %^Blinking Red^.", Lwhite, Black, 0, 0, 11, 1, 1, 0, 0
DE.LAY 4
CLREOL 11, 1, 0
Dis.Play "Blinking White on Black with {Yellow{ and ~Blue~", Lwhite, Black, 1, 0, 11, 1, 1, 1, 0
DE.LAY 4
CLREOL 11, 1, 0
Dis.Play "Normal White on Red with *%}Blinking Low intensity White}", Lwhite, RED, 0, 0, 11, 1, 1, 0, 0
DE.LAY 4
CLREOL 11, 1, 0
Dis.Play "Blinking White on Red, Centered, with @Cyan@", Lwhite, RED, 1, 0, 11, 1, 1, 1, 0
DE.LAY 4
CLREOL 11, 1, 0
Dis.Play "Well, `you` ~get~ @the@ ^idea^! }Hit} {the{ %|ENTER| key.", Lwhite, Black, 0, 0, 11, 1, 1, 1, 0
ENTER
RETURN
InputDemo: 'In.Put demo
ClrScrn Black
Dis.Play "You can tell In.Put how many keystrokes to accept before returning.", Lwhite, Black, 0, 0, 5, 1, 1, 0, 0
Dis.Play "You can do %^Hot Keys^ like this: IN.PUT 1, 0, 10, 0, 1, " + CHR$(34) + CHR$(34) + ", 0, 0, 1", Lwhite, Black, 0, 0, 6, 1, 1, 0, 0
IN.PUT 1, 0, LGREEN, Black, 1, "Hit any key > ", 7, 1, 1
IN.PUT 3, 0, Lwhite, RED, 1, "Now type 3 keys > ", 11, 1, 1
Dis.Play "As you can see, you may specify fore/background color for the input.", Lwhite, Black, 0, 0, 13, 1, 1, 0, 0
Dis.Play "You can specify a wait time in the second parameter of In.Put.", Lwhite, Black, 0, 0, 16, 1, 1, 0, 0
Dis.Play "For example: In.Put 5, 15, 10, 0, 1, " + CHR$(34) + CHR$(34) + ", 0, 0, 1 would wait for 5 chars or 15 seconds.", Lwhite, Black, 0, 0, 17, 1, 1, 0, 0
ENTER
RETURN
BltDemo: 'Make.Blt and Show.Blt demo
ClrScrn Black
Dis.Play "DoorFrame features two internal Bulletin generators.", Lwhite, Black, 0, 0, 10, 1, 1, 0, 0
Dis.Play "Make.Blt generates a Top Ten Listing of the highest scores obtained.", Lwhite, Black, 0, 0, 11, 1, 1, 0, 0
Dis.Play "Make.Blt.Current lists the current score rather than the highest.", Lwhite, Black, 0, 0, 12, 1, 1, 0, 0
Dis.Play "We'll demonstrate Make.Blt first. Enter a 5 digit number.", Lwhite, Black, 0, 0, 14, 1, 1, 0, 0
IN.PUT 5, 0, 10, 0, 1, "Score = ", 15, 1, 1
Score& = VAL(Response$)
MAKE.BLT Score& 'Create the BLT with the number he entered
SHOW.BLT "Y" 'Now show it to him.
ClrScrn Black
Dis.Play "Now enter a 4 digit number and we'll demonstrate Make.Blt.Current.", Lwhite, Black, 0, 0, 11, 1, 1, 0, 0
IN.PUT 4, 0, 10, 0, 1, "Score = ", 12, 1, 1
Score& = VAL(Response$)
MAKE.BLT.CURRENT Score&
SHOW.BLT "Y"
ClrScrn Black
Dis.Play "As you can see, Make.Blt.Current uses your current score regardless of your", Lwhite, Black, 0, 0, 11, 1, 1, 0, 0
Dis.Play "previous high score. When using Make.Blt, you would have to exceed your", Lwhite, Black, 0, 0, 12, 1, 1, 0, 0
Dis.Play "highest score before the bulletin listing would change.", Lwhite, Black, 0, 0, 13, 1, 1, 0, 0
ENTER
RETURN
SendDemo: 'Send demo
ClrScrn Black
Dis.Play "First we'll send an ASCII file.", Lwhite, Black, 0, 0, 11, 1, 1, 1, 0
DE.LAY 5
CLREOL 11, 1, 0
'First check for the existance of the files
Found% = EXIST2%("MICRONET.ASC")
IF Found% THEN
SEND "MICRONET.ASC", 1, 1 'Clear the screen, send it, use ENTER prompt
ELSE
Dis.Play "Whoops! Your Sysop does not have that file available!", LRED, Black, 0, 1, 11, 1, 1, 1, 0
DE.LAY 5
CLREOL 11, 1, 0
END IF
ClrScrn Black
Dis.Play "Now we'll send an ANSI file.", Lwhite, Black, 0, 0, 11, 1, 1, 1, 0
DE.LAY 5
CLREOL 11, 1, 0
Found% = EXIST2%("MICRONET.ASC")
IF Found% THEN
SEND "MICRONET.ANS", 1, 1
ELSE
Dis.Play "Whoops! Your Sysop does not have that file available!", LRED, Black, 0, 1, 11, 1, 1, 1, 0
DE.LAY 5
CLREOL 11, 1, 0
END IF
RETURN
Err.Routine:
ERRORS ERR, ERL
GoodBye:
ClrScrn Black
Mode% = PriorMode% 'Restore original color mode
EXIT.DOOR "Y" 'Leave & display ending message
END